perm filename EYE.SAI[GEO,BGB] blob
sn#012253 filedate 1972-11-14 generic text, type T, neo UTF8
00100 ENTRY DUMMY;
00200 BEGIN "EYE" COMMENT - CART'S EYE THREE - AUGUST 1972;
00300
00500 REQUIRE "ABBREV" SOURCE_FILE;
00600 REQUIRE "DPYIII" SOURCE_FILE;
00700 REQUIRE "SAITRG" SOURCE_FILE;
00710 REQUIRE "GEOMES" SOURCE_FILE;
00800
00900 α TELETYPE COMMAND STATE;
01000 ITG CHR,CTRL,META,LETT,αβ,BRK,FLG;
01100 STRING STR;
01200
01300 INTERNAL ITG CUT,DEL;
01400 EXTERNAL ITG ARRAY PADPDL[0:99];
01500 EXTERNAL ITG PDLPTR;
01600
01700 INTERNAL SAFE ITG ARRAY HEADER[0:9];
01800 INTERNAL SAFE ITG ARRAY TVBUF [0:10367];
01900
02000 INTERNAL SAFE ITG ARRAY PAC [0:1727];
02100 EXTERNAL SAFE ITG ARRAY DPYBUF[1:1500];
02200 SAFE ITG ARRAY HISTO[-1:64];
02300
02400 α SOURCE WINDOW CENTER;
02500 ITG SX,SY;
02600 REAL SOX,SOY;
02700 α OBJECT WINDOW;
02800 REAL OX,OY,MAG;
02900 α PSEUDO BEAM POSITION;
03000 REAL XXX,YYY;
03100 EXTERNAL SUBR CLIPIN (REAL XL,XH,YL,YH);
03200 EXTERNAL BOOLEAN SUBR CLIP (REFERENCE REAL X1,Y1,X2,Y2);
00100 SUBR AI(REAL X,Y);⊂ XXX←X*MAG+SOX;YYY←Y*MAG+SOY;⊃;
00200 SUBR AV(REAL X,Y);
00300 BEGIN
00400 REAL X1,Y1,X2,Y2;
00500 X1←XXX;Y1←YYY;X2←XXX←X*MAG+SOX;Y2←YYY←Y*MAG+SOY;
00600 IF CLIP(X1,Y1,X2,Y2) THEN
00700 ⊂ AIVECT(X1,Y1);AVECT(X2,Y2);⊃;
00800 END;
00900
01000 SUBR CROP;
01100 BEGIN "CROP"
01200 REAL OXL,OXH,OYL,OYH;
01300 SOX ← OX - SX*MAG;
01400 SOY ← OY - SY*MAG;
01500 OXL ← (OX - MAG*150*64) MAX -500;
01600 OXH ← (OX + MAG*150*64) MIN 500;
01700 OYL ← (OY - MAG*115*64) MAX -450;
01800 OYH ← (OY + MAG*115*64) MIN 450;
01900 CLIPIN(OXL,OXH,OYL,OYH);
02000 END;
00100 α INPUT A TELEVISION PICTURE;
00200 INTERNAL SUBR TVIN (STRING S);
00300 BEGIN "TVIN"
00400 STRING STR;ITG FLG; LABEL L1,L2;
00500 OPEN(1,"DSK",8,3,0,0,0,0);
00600 STR←S;IF FLG←(LENGTH(STR)=0) THEN GO L2;
00700 L1: LOOKUP(1,STR,FLG);
00800 IF FLG THEN LOOKUP(1,STR&".TMP[DAT,BGB]",FLG);
00900 L2: IF FLG THEN ⊂ OUTSTR(9&"TV FILE = ");
01000 STR←INCHWL;IF LENGTH(STR)=0 THEN RETURN;GO L1;⊃;
01100 ARRYIN(1,HEADER[0],10);
01200 ARRYIN(1,TVBUF[0],10368);
01300 RELEASE(1);
01400 END "TVIN";
00100 ITG X0,Y0,X,Y,I,RC,R,C;
00200 ITG CNT,BUF;
00300 EXTERNAL SUBR PACXOR;
00400 EXTERNAL ITG SUBR MKVIC;
00500
00600 SUBR DPYPGON(ITG P);
00700 BEGIN "DPYPGON"
00800 ITG X,Y,E,E0,V;
00900
01000 SUBR GETXY(ITG V);
01100 BEGIN "GETXY"
01200 RC←LAC(V-1);
01300 R←RC LSH-18; C←RC LAND '777777;
01400 Y←(108*64-R)*MAG; X←(C-144*64)*MAG;
01500 END "GETXY";
01600
01700 E←E0←CAR(P+1);V←CAR(E+1);GETXY(V);AI(X,Y);
01800 DO ⊂ V←CDR(E+1);GETXY(V);AV(X,Y); ⊃ UNTIL (E←CDR(V+1))=E0;
01900 END "DPYPGON";
02000
02100 SUBR REFRESH;
02200 BEGIN "REFRESH"
02300 ITG P,E,E0,V,I,CNT;
02400 DPYSET(DPYBUF);AIVECT(-500,-450);AVECT(+500,-450);
02500 AVECT(+500,+450);AVECT(-500,+450);AVECT(-500,-450);
02600 AIVECT(-100,400);DPYBIG(3);DPYSST("CUT = "&CVS(CUT));
02700 FOR I←1 TO PDLPTR DO
02800 BEGIN LABEL L1;
02900 P ← PADPDL[I];
03000 DPYPGON(P);
03100 END;
03200 DPYBIG(1);AIVECT(-511,430);
03300 FOR I←PDLPTR STEP -1 UNTIL (1 MAX (PDLPTR-20)) DO
03400 DPYSST("P"&CVS(PADPDL[I])&↓);
03500 DPYOUT(0);
03600 END "REFRESH";
00100 INTERNAL SUBR MKVICI;
00200 BEGIN "MKVICI"
00300 XISUBR MKPAP;
00350 XSUBR SMOOTH(ITG V1,V2;REAL X);
00400 XSUBR KLPGON(ITG I);
00500 ITG P1,P2,V1,V2,E,CHR;
00600 SX←SY←0;
00700 MAG ← 7/32; DEL ←32*64;
00800 CROP;
00900 PACXOR;
01000 WHILE (P1←MKVIC)≠0 DO
01100 BEGIN
01200 CNT ← ABS(LAC(P1-1));
01300 IF CNT≤10 THEN ⊂ KLPGON(P1);CONTINUE;⊃;
01700 α AD HOC SMOOTH CALLING;
01800 P2 ← MKPAP;
01900 E ← CAR(P2+1); V1 ← CAR(E+1); V2 ← CDR(E+1);
02000 SMOOTH(V1,V2,0.5); SMOOTH(V2,V1,0.5);
02100 KLPGON(P1);
00010 VBODY;
00020 V ← PADPDL(PDLPTR);
00030 F ← PADPDL(PDLPTR-1);
00040 B ← PADPDL(PDLPTR-2);
02200 PADPDL[INCREM(PDLPTR)]←P2;
02300 END;
02400 REFRESH;
02500 END "MKVICI";
02700 XSUBR THRESH(ITG CUT);
02800 SUBR MKIMAGE;
02900 BEGIN "MKIMAGE"
03000 ITG I;
03100 FOR I←8 STEP 5 UNTIL 60 DO
03200 ⊂ THRESH(I);MKVICI; ⊃;
03300 END "MKIMAGE";
00100 INTERNAL SUBR XPLOT;
00200 BEGIN
00300 STRING FILNAM;
00400 INTEGER FLG,CHN;
00500 CHN ← GETCHAN;
00600 OPEN(CHN,"DSK",8,0,3,0,0,0);
00700 DO BEGIN
00800 OUTSTR(13&10&"PLOT FILE = ");
00900 FILNAM ← INCHWL;
01000 ENTER(CHN,FILNAM&".PLT",FLG);
01100 END UNTIL ¬FLG;
01200 ARRYOUT(CHN,DPYBUF[1],DPYBUF[2]);
01300 RELEASE(CHN);
01400 END;
00100 ITG SUBR PIXPTR (ITG ROW,COL);
00200 BEGIN "PIXPTR"
00300 RETURN(POINT(6,
00400 TVBUF[(ROW*48)+(COL DIV 6)],6*(COL MOD 6)-1));
00500 END "PIXPTR";
00600
00700 SUBR HISTOGRAM;
00800 BEGIN "HISTOGRAM"
00900 ITG Q,I,PTR;
01000 HISTO[-1]←0;ARRBLT(HISTO[0],HISTO[-1],64);
01100 PTR ← PIXPTR(0,0);
01200 FOR I←0 TO 62207 DO
01300 ⊂ Q←ILDB(PTR);INCREM(HISTO[Q]);⊃;
01400 END "HISTOGRAM";
01500
01600 PROCEDURE DPYHISTO;
01700 BEGIN "DPYHISTO"
01800 ITG X,Y;
01900 REAL SX,SY; ITG QMAX,Q,I;
02000 ITG ARRAY DPYBUF[0:300];
02100 DPYSET(DPYBUF);DPYBIG(1);
02200 QMAX ← 0;
02300 FOR I←0 TO 63 DO QMAX ← QMAX MAX HISTO[I];
02400 SY ← 800/QMAX;
02500 SX ← 1024/64;
02600 AIVECT(511,-400);AVECT(-511,-400);
02700 FOR I←0 TO 63 DO
02800 ⊂ Q←HISTO[I];X←I*SX-512;Y←Q*SY-400;
02900 AVECT(X,Y);
03000 IF (I LAND 1) THEN
03100 ⊂ AIVECT(X-8,Y);DPYSST(CVS(I));AIVECT(X,Y);⊃;
03200 AVECT(X+SX,Y);⊃;
03300 AVECT(511,-400);
03400 DPYOUT(6);
03500 HYDPOG(1);HYDPOG(2);HYDPOG(3);HYDPOG(4);
03600 INCHRW;HYDPOG(6);
03700 END "DPYHISTO";
00100 SUBR OUTPGN;
00200 BEGIN "OUTPGN"
00300 ITG X,Y,E,E0,V,P,ECNT;
00400
00500 SUBR GETXY(ITG V);
00600 BEGIN "GETXY"
00700 RC←LAC(V-1);
00800 R←RC LSH-18; C←RC LAND '777777;
00900 Y←(108*64-R)*MAG; X←(C-144*64)*MAG;
01000 END "GETXY";
01100
01200 P ← PADPDL[1];
01300 OPEN(2,"DSK",8,0,3,0,0,0);
01400 ENTER(2,"O.JEG",0);
01500 WORDOUT(2,1);
01600 WORDOUT(2,CUT);
01700
01800 ECNT←0;
01900 E←E0←CAR(P+1);V←CAR(E+1);
02000 DO ⊂ V←CDR(E+1);ECNT←ECNT+1; ⊃ UNTIL (E←CDR(V+1))=E0;
02100 WORDOUT(2,ECNT);
02200 OUTSTR(9&"ECNT = "&CVS(ECNT)&↓);
02300
02400 E←E0←CAR(P+1);V←CAR(E+1);
02500 DO ⊂ V←CDR(E+1);GETXY(V);
02600 WORDOUT(2,X);WORDOUT(2,Y); ⊃ UNTIL (E←CDR(V+1))=E0;
02700 OUTSTR(9&"EOF"&↓);
02800 RELEASE(2);
02900 END;
00100 α CAREYE COMMAND SCANNER - A JUMP TABLE;
00200
00300 INTERNAL SIMPLE PROCEDURE CAREYE;
00400 BEGIN "CAREYE"
00500
00600 OUTSTR(↓&"o");
00700 WHILE TRUE DO
00800 BEGIN "LISTEN"
00900
01000 CHR ← INCHRW;
01100 αβ ← (CHR LSH -7)LAND 3;
01200 CTRL ← CHR LAND '200;
01300 META ← CHR LAND '400;
01400 CHR ← CHR LAND '177;
01500 LETT ← CHR LAND '37;
01600
00100 IF "A"≤CHR ∧ CHR≤"Z" ∨ "a"≤CHR ∧ CHR≤"z" THEN
00200 CASE LETT OF
00300 BEGIN ;
00400 "A" ;
00500 "B" RETURN;
00600 "C" ⊂ STR←INCHWL;CUT←INTSCAN(STR,BRK);THRESH(CUT);OUTSTR("o");⊃;
00700 "D" ;
00800 "E" ;
00900 "F" ;
01000 "G" ;
01100 "H" ⊂ HISTOGRAM;DPYHISTO;⊃;
01200 "I" ⊂ TVIN(INCHWL);OUTSTR("o");⊃;
01300 "J" ;
01400 "K" IF PDLPTR≥1 THEN
01500 ⊂ XSUBR KLPGON(ITG P);
01550 KLPGON(PADPDL[(DECREM(PDLPTR))+1]);REFRESH;OUTSTR("o");⊃;
01600 "L" ;
01700 "M" ⊂ MKVICI;OUTSTR(↓&"o");⊃;
01800 "N" ;
01900 "O" OUTPGN;
02000 "P" XPLOT;
02100 "Q" MKIMAGE;
02200 "R" ;
02300 "S" ;
02400 "T" ;
02500 "U" ;
02600 "V" ;
02700 "W" ;
02800 "X" ;
02900 "Z" ;
03000 END;
03100
03200 IF CHR=13 THEN ⊂ OUTSTR("o");CONTINUE;⊃;
03300 IF CHR=":" THEN SX←SX+DEL ELSE
03400 IF CHR=";" THEN SX←SX-DEL ELSE
03500 IF CHR=")" THEN SY←SY+DEL ELSE
03600 IF CHR="(" THEN SY←SY-DEL ELSE
03700 IF CHR="/" THEN DEL←(DEL%2)MAX 1 ELSE
03800 IF CHR="\" THEN DEL←(DEL*2) ELSE
03900 IF CHR="*" THEN MAG←MAG*2 ELSE
04000 IF CHR="-" THEN MAG←MAG/2 ELSE CONTINUE;
04100 CROP;REFRESH;
04200
04300 END "LISTEN";
04400 END "CAREYE";
04500 END "EYE";